Attribute VB_Name = "modClearArray"
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'
' You are entitled to license free distribution of any application
'   that uses this file if you own a copy of the book, or if you
'   have obtained the file from a source approved by the author. You
'   may redistribute this file only with express written permission
'   of the author.
'
' This file depends on:
'   References:
'     VBoostTypes6.olb (VBoost Object Types (6.0))
'     VBoost6.Dll (VBoost Object Implementation (6.0)) (optional)
'   Files:
'     VBoost.Bas (optional)
'   Minimal VBoost conditionals:
'     VBOOST_INTERNAL = 1 : VBOOST_CUSTOM = 1
'   Conditional Compilation Values:
'     NOVBOOST = 1 'Removes VBoost dependency
'
' This file is discussed in Chapter 2.
'***************************************************************
Option Explicit

Private Type SAOwner
    Owner As ArrayOwner
    pSA() As SafeArray
End Type
Private m_SAOwner As SAOwner

Public Sub ClearArrayData(ByVal ppSA As Long)
Dim pSA As Long
Dim fOldFeatures As Integer
    If m_SAOwner.Owner.SA.cDims = 0 Then
        InitArrayOwner m_SAOwner.Owner, LenB(m_SAOwner.pSA(0)), &H13, False
    End If
    With m_SAOwner.Owner.SA
        #If NOVBOOST Then
            CopyMemory pSA, ByVal ppSA, 4
        #Else
            pSA = VBoost.Deref(ppSA)
        #End If
        If pSA = 0 Then Exit Sub
        .pvData = pSA
        With m_SAOwner.pSA(0)
            fOldFeatures = .fFeatures
            .fFeatures = fOldFeatures Or 2 'Turn on static
            'In most cases, we can just call SafeArrayDestroy here
            'to do the same thing.  However, in the FADF_RECORD case
            'this would also release the IRecordInfo pointer preceding
            'the descriptor, which would cripple the array.
            On Error Resume Next
            SafeArrayDestroyData pSA
            On Error GoTo 0
            .fFeatures = fOldFeatures
        End With
        '.pvData = 0
    End With
End Sub

Public Sub FixArraySize(ByVal ppSA As Long)
Dim pSA As Long
    If m_SAOwner.Owner.SA.cDims = 0 Then
        InitArrayOwner m_SAOwner.Owner, LenB(m_SAOwner.pSA(0)), &H13, False
    End If
    With m_SAOwner.Owner.SA
        #If NOVBOOST Then
            CopyMemory pSA, ByVal ppSA, 4
        #Else
            pSA = VBoost.Deref(ppSA)
        #End If
        If pSA = 0 Then Exit Sub
        .pvData = pSA
        With m_SAOwner.pSA(0)
            .fFeatures = .fFeatures Or &H10 'FADF_FIXEDSIZE
        End With
        '.pvData = 0
    End With
End Sub
